home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / runtime.sit / fconv.r < prev    next >
Encoding:
Text File  |  1992-09-19  |  4.2 KB  |  205 lines  |  [TEXT/MPS ]
  1. /*
  2.  * fconv.r -- abs, cset, integer, numeric, proc, real, string.
  3.  */
  4.  
  5. "abs(N) - produces the absolute value of N."
  6.  
  7. function{1} abs(n)
  8.    /*
  9.     * If n is convertible to a small integer or real, this code returns
  10.     * -n if n is negative -- not valid in all cases.  (Should return a
  11.     * LargeInt in that case?)
  12.     */
  13.    if cnv:(exact)C_integer(n) then {
  14.       abstract {
  15.          return integer
  16.          }
  17.       inline {
  18.          return C_integer Abs(n);
  19.          }
  20.       }
  21. #ifdef LargeInts
  22.    else if cnv:(exact)integer(n) then {
  23.       abstract {
  24.          return integer
  25.          }
  26.       inline {
  27.          cpbignum(&n,&result);
  28.      BlkLoc(result)->bignumblk.sign = 0;
  29.          return result;
  30.          }
  31.       }
  32. #endif                    /* LargeInts */
  33.    else if cnv:C_double(n) then {
  34.       abstract {
  35.          return real
  36.          }
  37.       inline {
  38.          return C_double Abs(n);
  39.          }
  40.       }
  41.    else
  42.       runerr(102,n)
  43. end
  44.  
  45.  
  46. /*
  47.  * The convertible types cset, integer, real, and string are identical
  48.  *  enough to be expansions of a single macro, parameterized by type.
  49.  */
  50. #begdef ReturnYourselfAs(t)
  51. #t "(x) - produces a value of type " #t " resulting from the conversion of x, "
  52.    "but fails if the conversion is not possible."
  53. function{0,1} t(x)
  54.  
  55.    if cnv:t(x) then {
  56.       abstract {
  57.          return t
  58.          }
  59.       inline {
  60.          return x;
  61.          }
  62.       }
  63.    else {
  64.       abstract {
  65.          return empty_type
  66.          }
  67.       inline {
  68.          fail;
  69.          }
  70.       }
  71. end
  72.  
  73. #enddef
  74.  
  75. ReturnYourselfAs(cset)     /* cset(x) - convert to cset or fail */
  76. ReturnYourselfAs(integer)  /* integer(x) - convert to integer or fail */
  77. ReturnYourselfAs(real)     /* real(x) - convert to real or fail */
  78. ReturnYourselfAs(string)   /* string(x) - convert to string or fail */
  79.  
  80.  
  81. "numeric(x) - produces an integer or real number resulting from the "
  82. "type conversion of x, but fails if the conversion is not possible."
  83.  
  84. function{0,1} numeric(n)
  85.  
  86.    if cnv:(exact)integer(n) then {
  87.       abstract {
  88.          return integer
  89.          }
  90.       inline {
  91.          return n;
  92.          }
  93.       }
  94.    else if cnv:real(n) then {
  95.       abstract {
  96.          return real
  97.          }
  98.       inline {
  99.          return n;
  100.          }
  101.       }
  102.    else {
  103.       abstract {
  104.          return empty_type
  105.          }
  106.       inline {
  107.          fail;
  108.          }
  109.       }
  110. end
  111.  
  112.  
  113. "proc(x,i) - convert x to a procedure if possible; use i to resolve "
  114. "ambiguous string names."
  115.  
  116. #ifdef MultiThread
  117. function{0,1} proc(x,i,c)
  118. #else                    /* MultiThread */
  119. function{0,1} proc(x,i)
  120. #endif                    /* MultiThread */
  121.  
  122.    if is:proc(x) then {
  123.       abstract {
  124.          return proc
  125.          }
  126.       inline {
  127. #ifdef MultiThread
  128.      if (!is:null(c)) {
  129.         struct progstate *p;
  130.         if (!is:coexpr(c)) runerr(118,c);
  131.         /*
  132.          * Test to see whether a given procedure belongs to a given
  133.          * program.  Currently this is a sleazy pointer arithmetic check.
  134.          */
  135.         p = BlkLoc(c)->coexpr.program;
  136.         if (! InRange(p, BlkLoc(x)->proc.entryp.icode,
  137.               (char *)p + p->hsize))
  138.            fail;
  139.         }
  140. #endif                    /* MultiThread */
  141.          return x;
  142.          }
  143.       }
  144.  
  145.    else if cnv:tmp_string(x) then {
  146.       /*
  147.        * i must be 1, 2, or 3; it defaults to 1.
  148.        */
  149.       if !def:C_integer(i, 1) then
  150.          runerr(101, i)
  151.       inline {
  152.          if (i < 1 || i > 3) {
  153.             irunerr(205, i);
  154.             errorfail;
  155.             }
  156.          }   
  157.  
  158.       abstract {
  159.          return proc
  160.          }
  161.       inline {
  162.          struct b_proc *prc;
  163. #ifdef MultiThread
  164.      struct progstate *prog, *savedprog;
  165.  
  166.      savedprog = curpstate;
  167.      if (is:null(c)) {
  168.         prog = curpstate;
  169.         }
  170.      else if (is:coexpr(c)) {
  171.         prog = BlkLoc(c)->coexpr.program;
  172.         }
  173.      else {
  174.         runerr(118,c);
  175.         }
  176.  
  177.      ENTERPSTATE(prog);
  178. #endif                        /* MultiThread */
  179.  
  180.          /*
  181.           * Attempt to convert Arg0 to a procedure descriptor using i to
  182.           *  discriminate between procedures with the same names.  Fail if
  183.           *  the conversion isn't successful.
  184.           */
  185.          prc = strprc(&x, i);
  186.  
  187. #ifdef MultiThread
  188.      ENTERPSTATE(savedprog);
  189. #endif                        /* MultiThread */
  190.          if (prc == NULL)
  191.             fail;
  192.          else
  193.             return proc(prc);
  194.          }
  195.       }
  196.    else {
  197.       abstract {
  198.          return empty_type
  199.          }
  200.       inline {
  201.          fail;
  202.          }
  203.       }
  204. end
  205.